00100	C**** ITMSUB, BMS, METER, RNOTE , MAKNUM ********
00200	C  ********** WHOLE & HALF RESTS, BEAMS ******
00300		SUBROUTINE ITMSUB
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(8),RSTJC/MIN/MINI,RMINI
00700		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(8),JJB,POS/PLTR/PLT,RHT,DIS
00900		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01000		1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01100		1,(JK,JQ(9)),(JF,JQ(4)),(RJI,RJQ(7)),(RJH,RJQ(6))
01200		1 ,(RJG,RJQ(5)),(RJD,RJQ(2)),(RJI,RJQ(7)),(RJJ,RJQ(8))
01300		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01400		RST7=RSTJC*7.
01500		RST18=RSTJC*18.
01600	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
01700	
01800		RJBQ=JB
01900		JY=0
02000		IF(JA.EQ.9)GO TO 90
02100		IF(JA.EQ.10)GO TO 100
02200	C  GO TO LINES, BEAMS, STAVES.
02300	C   NEXT DRAWS STRAIGHT LINES
02400	
02500		RD=RJD*RST7
02600		RA=0
02700	C WHY "*RSTJC"????
02800		RX=RTF+POS
02900		IF(JE.EQ.50)GO TO 300
03000		IF(RJF.GT.0)GO TO 401
03100	C  FOR BAR LINES
03200		JA=44
03300	C  CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
03400		IF(JG)GO TO 407
03500	C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
03600		IF(JG.EQ.0)JG=JD/100
03700		RA=1
03800		IF(PLT.GE.0)GO TO 40
03900		JG=JG+1
04000		RA=1./DIS
04100	C  BAR LINES PLOT AS DOUBLE THICKNESS
04200	40	RX=RTF*RSTJC+POS
04300		L=MOD(JD,100)+JC+3
04400	C JD=401 MAKES 4X THICK BARLINE - ONE STAFF
04500		RY=STFF(L)+.5+RSTFAC(L)*58.
04600		RW=RY
04700		RJX=RJBQ
04800	42	CALL LINES(RJBQ,RX,3)
04900	CC	IF(JG.EQ.-2)GO TO 404
05000	C  IF JG<0 THEN WIGGLEY LINES ARE MADE.
05100		RJ=-1.
05200	406	CALL LINES(RJX,RY,2)
05300		IF(JG.LE.0)RETURN
05400	C  FOR 'HEAVY' LINE.
05500		RJX=RJX+RA
05600		CALL LINES(RJX,RY,2)
05700		JG=JG-1
05800		RY=RW
05900		IF(RJ)RY=RX
06000		RJ=-RJ
06100		GO TO 406
06200	43	IF(RA.GT.0)GO TO 403
06300		RETURN
06400	C   HOV IS RA.NE.0?
06500	C  DRAWS BAR LINES. JD>0 CAUSES FULL LINE.
06600	403	RA=RA-3.72
06700		RJBQ=RJBQ+22
06800		RJX=RJX+22
06900	C   DO ABOVE NEED *RSTJC? ************
07000	C **** BASED ON '596' ****
07100		GO TO 42
07200	
07300	C  FOR CRESC., DECRESC.
07400	300	RA=ABS(RJG/2.0)*RST7
07500	C   AMOUNT OF SPREAD
07600		RJ=RJBQ
07700		RX=RX-RST18+RD
07800		IF(RJH.NE.0)GO TO 302
07900	C  JUMP TO MAKE BOX
08000		RJF=RHORZ(RJF)
08100		IF(RJG)GO TO 301
08200		RJ=RJF
08300		RJF=RJBQ
08400	301	CALL LINX(RJ,RX+RA,RJF,RX)
08500		CALL LINES(RJ,RX-RA,2)
08600	C  FOR CRESC, DECRESC: 4 POS1, STF, HGT, 50, POS1, +OR-N
08700		RETURN
08800	
08900	302	RJH=RJH*RST7
09000		RJI=RJI*RST7
09100		IF(RJI.EQ.0)RJI=RJH
09200		RJB=RJBQ-RJH/2.
09300		RX=RX-RJI/2.
09400	C  DRAWS BOX, CENTER IS IN MIDDLE 
09500	C  4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
09600		CALL LINX(RJB,RX,RJB+RJH,RX)
09700		CALL LINES(RJB+RJH,RX+RJI,2)
09800		CALL LINES(RJB,RX+RJI,2)
09900		CALL LINES(RJB,RX,2)
10000		RETURN
10100	
10200	C  DASHES
10300	401	POS=POS-RST18
10400	C********* 27/9/72 ******
10500		IF(JG.EQ.0)GO TO 407
10600	CC	IF(JG)GO TO 421
10650		IF(JG)GO TO 407
10700		IF(RJH.EQ.0)RJH=.8
10800	C  P8 CAN SET SIZE OF DASH
10900		RD=RD+POS
11000		IF(ABS(RJF-RJB).LT..01)GO TO 402
11100	C VERTICAL DASHES IF P6=P2
11200		RJF=RHORZ(RJF)
11300		RJH=RJH*5.96*RSTJC
11400	420	CALL LINX(RJBQ,RD,RJBQ+RJH,RD)
11500		RJBQ=RJBQ+RJH+RJH
11600		IF(RJBQ.GE.RJF)RETURN
11700		GO TO 420
11800	
11900	CC	IF(JG.GT.0)JG=0
12000	CC	GO TO 407
12100	402	RA=POS+RJE*RST7
12200		RJ=RJH*RST7
12300	CC	RX=RD+POS
12400		L=3
12500		K=2
12600	41	IF(RD.GT.RA)RETURN
12700	C  DASHES MUST GO FROM BOTTOM TO TOP.
12800		CALL LINES(RJBQ,RD,L)
12900		RD=RD+RJ
13000		CALL EXCH(K,L)
13100		GO TO 41
13200	
13300	CC421	RA=RJF-RJB-4.
13400	CC	RJF=RJB+2
13500	407	RX=RD+POS
13600		RY=RJE*RST7+POS
13700		IF(JG.EQ.-1)GO TO 408
13750		IF(JG.NE.0)GO TO 4041
13800	C  FOR 'TR' JG=-2, 'ARPEGG' JG=-1,  STRAIGHT LINES JG=0
13900		RJX=IFIX(RHORZ(RJF))
14000		GO TO 42
14100	4041	CALL NOZERO(RJH)
14200		CALL LINES(RJBQ,RX,3)
14300	C  DRAWS STRAIGHT LINES. ETC.
14400	CC404	L=(RA+4)/(1.5*RSTJC)
14500		RJ=RY
14600		RA=9.*RSTJC*RJH
14650		L=(RJF-RJB)/(RA/5.96)
14700	C  P8=HORZ. WIGGLE SIZE;  P5=VERT.
14800	404	DO 405 K=1,L
14900		RJBQ=RJBQ+RA
15000		CALL LINES(RJBQ,RJ,2)
15100	405	CALL EXCH(RX,RJ)
15200		RETURN
15300	
15400	408	IF(RX.GT.RY)CALL EXCH(RX,RY)
15500		RA=4.*RSTJC
15600		IF(RJH.NE.0)RA=RJH*RA
15700	C  USE P8 TO SET WIGGLE WIDTH.  (HGT CANNOT BE CHANGED YET..)
15800		RX=RX-12.*RSTJC
15900		RJ=6.*RSTJC
16000		RJX=4*RSTJC
16100		RW=RJBQ-RJX
16200		CALL LINES(RW,RX-RJ,3)
16300	CC	RJX=RA*RSTJC
16400	410	CALL LINES(RJBQ+RA,RX,2)
16500		CALL LINES(RW,RX+RJ,2)
16600		RX=RX+12.*RSTJC
16700		IF(RX.LT.RY)GO TO 410
16800		RETURN
16900	C  VERTICAL WIGGLE
17000	
17100	
17200	C  NEXT IS FOR BEAMS
17300	90	RMINI=RSTJC
17400		RX=2.7*RSTJC
17500	C******************************
17600		IF(JJ.LT.10)GO TO 91
17700	C NEXT FOR INNER, PARTIAL BEAMS
17800		RJJ=AMOD(RJJ,10.)
17900		GO TO(2,3,4),JJ/10
18000	2	RJH=RJI+RX
18100		GO TO 4
18200	3	RJH=RJI-RX
18300	C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
18400	4	RH=RHORZ(RJH)
18500	C  LEFT INNER POS.
18600		GO TO 1
18700	C******************************
18800	91	IF(JH.GE.0)GO TO 1
18900	92	RJI=RJB+RX
19000		IF(JH.LE.-20)RJI=RJF-RX
19100	192	JH=-JH
19200		IF(JJ.EQ.0)JJ=MOD(JH,10)
19300		JH=JH-JJ
19400		IF(JJ.EQ.0)JJ=1
19500		RJJ=JJ
19600	C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
19700	1	IF(IABS(JD).LT.100)GO TO 97
19800		RMINI=.6*RSTJC
19900		RJE=AMOD(RJE,100.0)
20000	C   SPACE BETWEEN BEAMS
20100	97	RJ=RMINI*11.
20200		RW=RMINI*RHGT
20300	C  DIST. UP OR DOWN FROM NOTE HEAD.
20400		RJA=RJJ*RJ
20500	C  DISPLACEMENT
20600		RD=RHORZ(ABS(RJI))
20700	C  POSITION 3
20800		RJX=CENTR-RW+RJA
20900	C  FINAL HEIGHT
21000	CC??????	RX=MOD(JG,10)-MOD(JH,10)
21100		RX=MOD(JG,10)
21200		JJB=JG-20
21300		RA=RHORZ(RJF)
21400	C  HORIZANTAL DIST.
21500		RJY=RJE*RST7+POS-RST18-RW+RJA
21600	C************************
21700		RW=R14*RMINI
21750		RY=1.
21800		IF(JG.GE.20)GO TO 930
21900	C JUMP IF STEMS ARE DOWN
21950		RY=-RY
21975	C  FOR  THICKENING INCR.
22000		JJB=JG-10
22100		RJ=-RJ
22200	CCAUG.7,73	RJA=RMINI*R2HGT-2.*RJA-3.
22300	CC	RY=-3
22400	CC	IF(RMINI.LT..65)RY=-1
22500	CC	RJA=RMINI*R2HGT-2.*RJA+RY
22510		RJA=RMINI*R2HGT-2.*RJA
22600		RJX=RJX+RJA
22700		RJY=RJY+RJA
22800		RJBQ=RJBQ+RW
22900	C  POSITION 1
23000		RA=RA+RW
23100	C  POSITION 2
23200		RD=RD+RW
23300	C******************************
23400		RH=RH+RW
23500	930	RSTJC=RSTJC*RBM
23600	C  RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
23700	93	IF(JJB.GT.RX)GO TO 94
23800		IF(JJ.GE.10)GO TO 7
23900	C**********************
24000		IF(JH.EQ.0)GO TO 94
24100		RJC=RW
24200	C******************************
24300		IF(RJI.EQ.0)GO TO 292
24400	 	IF(JH.GE.20)GO TO 193
24500	C******************************
24600	CC	IF(JI.GT.0)GO TO 293
24700	293	RX=RJBQ-RD
24800		GO TO 194
24900	C******************************
25000	7	RHX=RH-RJBQ
25100	CC	RJC=RX-RJBQ
25200		RJC=RD-RJBQ
25300		GO TO 292
25400	193	RX=RD-RA
25500	194	RJC=ABS(RX)
25600	292	DISX=ABS(RJBQ-RA)
25700		HGT=RJX-RJY
25800		IF(JJ.GE.10)HGT1=HGT*RHX/DISX
25900	C**********************
26000		RJC=RJC/DISX
26100	195	HGT=HGT*RJC
26200	196	L=JH/10
26300		JH=0
26400		IF(JJ.GE.10)GO TO 8
26500	C***************
26600		IF(L.EQ.1)GO TO 95
26700	C   BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20)
26800		RJBQ=RD
26900		RJX=RJY+HGT
27000		GO TO 94
27100	C**************
27200	8	RJBQ=RH
27300		RA=RD
27400		RJY=RJX-HGT
27500		RJX=RJX-HGT1
27600		GO TO 94
27700	95	RA=RD
27800		RJY=RJX-HGT
27900	94	RC=0
28000		L=6
28100	CC	IF(RMINI.LT..65)L=3
28110		IF(RMINI.LT.1.)L=5.*RMINI
28200		CALL LINES(RJBQ,RJX,3)
28300		DO 941 K=1,L
28400		CALL BMS
28500		IF(PLT.GE.0)GO TO 940
28600	CC	RC=RC+1
28650		RC=RC+RY
28675	C FOR THICKENING.
28700		CALL BMS
28800		CALL EXCH(RA,RJBQ)
28900	941	CALL EXCH(RJY,RJX)
29000		CALL BMS
29100	C  DRAWS 5 LINES FOR BEAMS.
29200	940	JJB=JJB-1
29300		IF(JJB.LE.0)RETURN
29400	C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.
29500		RJY=RJY+RJ
29600		RJX=RJX+RJ
29700		GO TO 93
29800	
29900	100	RA=0
30000		RJB=RHORZ(RJB)
30100		RJ=RHORZ(FLOAT(JD))
30200		IF(JD.EQ.0)RJ=596
30300	C  FOR STAFF LINES: 10, POS 1, HGT(3 TO -3), 2ND POS., UP-DOWN(NT #S)
30400		JC=JC+4
30500		IF(RJF.EQ.0)RJF=RSTFAC(JC)
30600		IF(RJF.EQ.0)RJF=1.
30700		RSTFAC(JC)=RJF
30800		STFF(JC)=(JC-1)*123-369.+RJE*7.*RJF
30900		RX=STFF(JC)+RTF*RJF
31000	C  FOR RTF SEE DATA
31100	C  FOR 2 PASS PLOTTING
31200		RJF=RJF*14.
31300		DO 6 K=1,5
31400		RZ=RJ
31500		RW=RJB
31600		IF(K.EQ.2.OR.K.EQ.4)CALL EXCH(RW,RZ)
31700		CALL LINX(RZ,RX,RW,RX)
31800	6	RX=RX+RJF
31900		END
32000	
32100		SUBROUTINE BMS
32200		COMMON/STF/RSTFAC(8),RSTJC/BM/RA,RC,RJY
32300		CALL LINES(RA,RJY+RC*RSTJC,2)
32400		END
32500	
32600		SUBROUTINE METER
32700		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RSTFAC(8),RSTJC
32800		EQUIVALENCE (JC,JQ(1)),(RJD,RJQ(2)),(RJH,RJQ(6)),(RJG,RJQ(5))
32900	     1,(RJF,RJQ(4)),(RJE,RJQ(3)),(RJG,RJQ(5)),(JQ(14),X),
33000	     1(JQ(17),RX),(JQ(18),RY)
33100	
33200	C  PARAMS  18 / POS / STF / TOP NUM/ BOT NUM/ VERT.HGT/ SIZE FAC.
33300	
33400		X=8.
33500		RW=RJE
33600	C  BOTTOM NUM
33700		RX=RJD
33800	C  TOP NUM
33900		RY=RJF
34000	C  HEIGHT
34100		RJE=RJG
34200	C  SIZE
34300		M=0
34400	2	RJD=RY+X
34500		CALL MAKNUM(RX)
34600		IF(M)RETURN
34700	C  STICK AROUND FOR BOTTOM NUM
34800		M=-1
34900		X=4.
35000		RX=RW
35100	C  GET BOTTOM NUM
35200		GO TO 2
35300		END
35400	
35500		SUBROUTINE RNOTE(X)
35600		COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
35700		X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
35800		END
35900	
36000		SUBROUTINE MAKNUM(RNUM)
36100		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RSTFAC(8),RSTJC
36200		EQUIVALENCE (JC,JQ(1)),(RJD,RJQ(2)),(RJH,RJQ(6)),(RJG,RJQ(5))
36300	     1,(RJF,RJQ(4)),(RJE,RJQ(3)),(RJG,RJQ(5)),(JQ(15),B),(JQ(16),C)
36400		DATA RS/11.0/
36500		JBX=JB
36600		JC=JB-RS*RSTJC
36700	C  FOR 2 DIGIT NUMBER
36800		CALL NOZERO(RJE)
36900		RJG=999999.99
37000	C  BLANKS
37100		RJH=RJG
37200	2	RJF=485000.00
37300	C  UPPER CASE - BDR40
37400		IF(RNUM.GT.9.)GO TO 3
37500	C  JUMP FOR 2 DIGIT NUMBER
37600		RJF=RJF+RNUM+.47
37700	C  PUTS BLANK ON END (.47)
37800		GO TO 1
37900	
38000	3	B=IFIX(RNUM/10.)
38100		C=AMOD(RNUM,10.)
38200		RJF=RJF+B+C/100.
38300		JB=JC
38400	1	CALL ALPHA
38500		JB=JBX
38600	C  RETURNS ORIG. HORIZ. POS.
38700		END
38800	C  MAKES ONLY 1 AND 2 DIGIT NUMS NOW.  EXPAND LATER.